home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CL5 / REP00.PRG < prev    next >
Encoding:
Text File  |  1993-11-26  |  10.6 KB  |  328 lines
  1. ///////////////////////////////////////////////////////////////
  2. //
  3. //  Module : REP00.PRG
  4. //
  5. //  Created by SUMMER'93 (c) on Fri Nov 26 14:50:48 1993
  6. //
  7. ///////////////////////////////////////////////////////////////
  8. #include "snj.ch"
  9. // The following vars were made static because they were 'inherited'
  10. // SWIDTH BWIDTH 
  11. // The following statics were declared 'PUBLIC' in the S87 code
  12. // OR were private and inherited by called functions
  13. // If they are used outside this module there will be a set/get
  14. // function with the same name as the var in this module
  15. static REPHD1, REPHD2, REPHD3, REPHD4, REPHD5, SWIDTH, BWIDTH
  16. // R E P 0 0
  17. procedure REPMAIN
  18. // Calls: QBPROMPT REPARAM REPWIP REPLIST REPREV 
  19. // Called By: BODYWORK 
  20. //       Main controlling routine for reports
  21. local REPCOM, CGROUP, STARTD, FINISHD, OLDSCR
  22.  
  23.  
  24. SWIDTH := BWIDTH := 8 
  25. CGROUP := space(4 )
  26. STARTD := FINISHD := blank(date())
  27. set deleted on 
  28. @ 4, 22 clear to 20, 58 
  29.  
  30. do while .t. 
  31.     REPHD1 := REPHD2 := REPHD3 := REPHD4 := REPHD5 := "" 
  32.  
  33.     GETOUT( .f.  )
  34.     REPCOM := QBPROMPT( "Current Work|List|Revenue|Quit|", ;
  35.     "Reports can be between two dates, and for a Customer type", 1 )
  36.  
  37.     do case 
  38.         case REPCOM  = 1  // Work in Progress
  39.             do REPARAM with CGROUP, STARTD, FINISHD, "Work in Progress" 
  40.             if !GETOUT() 
  41.                 save screen to OLDSCR 
  42.                 do REPWIP with CGROUP, STARTD, FINISHD 
  43.                 restore screen from OLDSCR 
  44.             endif 
  45.         case REPCOM  = 2 
  46.             do REPARAM with CGROUP, STARTD, FINISHD, "List of Invoices" 
  47.             if !GETOUT() 
  48.                 save screen to OLDSCR 
  49.                 do REPLIST with CGROUP, STARTD, FINISHD 
  50.                 restore screen from OLDSCR 
  51.             endif 
  52.         case REPCOM  = 3 
  53.             do REPARAM with CGROUP, STARTD, FINISHD, "Invoice Revenue" 
  54.             if !GETOUT() 
  55.                 save screen to OLDSCR 
  56.                 do REPREV with CGROUP, STARTD, FINISHD 
  57.                 restore screen from OLDSCR 
  58.             endif 
  59.         case REPCOM  = 4 .or. REPCOM  = 0 
  60.             exit 
  61.     endcase 
  62.     close database 
  63. enddo 
  64. return 
  65.  
  66. //**********************************************************************
  67.  
  68. procedure REPARAM( CGROUP, STARTD, FINISHD, RTITLE ) // Amended by SUMMER93
  69. // Calls: QBLAYOUT QBBOX VCUSTTYP QB2DATES QBREAD QBPROMPT QBMESS QBPRCTL 
  70. // Called By: REPMAIN 
  71. local m, RORDER, GETLIST
  72. GETLIST := {}
  73.  
  74. m := "Choose Order for Report" 
  75. do QBLAYOUT with RTITLE 
  76. do QBBOX with 40 
  77.  
  78. CGROUP := blank( CGROUP )
  79. @ 5, 26 say "Customer Group:" get CGROUP picture "!!!!" valid VCUSTTYP( 5, 42;
  80. , .t. )
  81.  
  82. if !"Progress" $ RTITLE 
  83.     @ 7, 27 say "Start date:" 
  84.     @ 9, 26 say "Finish date:" 
  85.     do QB2DATES with "Group, Start & Finish dates - blank implies ALL", 7, 39;
  86.     , STARTD, 9, 39, FINISHD 
  87. else 
  88.     do QBREAD with "Enter Customer Group - blank implies ALL" , , @GETLIST
  89.     // Call amended
  90.     STARTD := blank( date())
  91.     FINISHD := ctod( "31/12/99" )
  92. endif 
  93. if !GETOUT() 
  94.     CGROUP := MCUSTTYP() 
  95.     if empty( CGROUP )
  96.         RORDER := substr( "DCQ", QBPROMPT("Date|Customer group|Quit|", m, 1 );
  97.         , 1 )
  98.         REPHD3 := "Listing for ALL Customer Groups" 
  99.     else 
  100.         RORDER := "D" 
  101.         REPHD3 := "Listing for Customer Group  " + trim( MCDESC() )
  102.     endif 
  103.     GETOUT( ( QBRESP()  = "Q" ) )
  104. endif 
  105. if GETOUT() 
  106.     return 
  107. endif 
  108.  
  109. REPHD1 := QBTITLE()  + space( 10 ) + RTITLE + space( 10 ) + QBDATE() 
  110. REPHD3 := center( trim(REPHD3 ) + "   -  Ordered by " + iif(RORDER  = "C", ;
  111. "Group", "Date" ), 79 )
  112.  
  113. select 0 
  114. use INVOICE 
  115. set softseek on 
  116. do case 
  117.     case RORDER  = "D" 
  118.         set index to INVDATE 
  119.         seek dtos( STARTD ) + trim( CGROUP )
  120.         GETOUT( ( eof()) .or.( INVOICE->DATEOUT > FINISHD ) )
  121.     case RORDER  = "C" 
  122.         set index to INVCUST 
  123.         seek "!   " + dtos( STARTD )
  124.         if found( )
  125.             do while(  !eof()) .and.( INVOICE->DATEOUT < STARTD )
  126.                 skip 
  127.             enddo 
  128.             GETOUT( ( INVOICE->DATEOUT > FINISHD ) .or.( eof()) )
  129.         endif 
  130. endcase 
  131.  
  132. if GETOUT() 
  133.     do QBMESS with "No matching Invoices", COLFLASH() , 5 
  134. else 
  135.     select 0 
  136.     use PARTS index PARTINV alias PARTS 
  137.     select INVOICE 
  138.     do QBPRCTL with " " 
  139. endif 
  140.  
  141. return 
  142.  
  143. //**********************************************************************
  144.  
  145. function REPMORE( STARTD, FINISHD ) // Amended by SUMMER93
  146. // Calls: 
  147. // Called By: REPLIST REPREV 
  148. // The following locals have been declared by Summer'93
  149. // RETVAL 
  150. local RETVAL
  151.  
  152. RETVAL := ( INVOICE->DATEOUT >= STARTD .and. INVOICE->DATEOUT <= FINISHD )
  153. RETVAL := RETVAL .and.(  !(eof().or. GETOUT() ))
  154.  
  155. return RETVAL 
  156.  
  157. //**********************************************************************
  158.  
  159. function REPGROUP( CGROUP ) // Amended by SUMMER93
  160. // Calls: 
  161. // Called By: REPLIST REPREV REPWIP 
  162. // The following locals have been declared by Summer'93
  163. // RETVAL 
  164. local RETVAL
  165.  
  166. RETVAL := ( empty(CGROUP ).or. CGROUP  = INVOICE->CUSTTYPE )
  167.  
  168. return RETVAL 
  169.  
  170. //**********************************************************************
  171.  
  172. procedure REPLIST( CGROUP, STARTD, FINISHD ) // Amended by SUMMER93
  173. // Calls: QBPUTH REPMORE REPGROUP QBPUTL QBPRCTL 
  174. // Called By: REPMAIN 
  175. //       List of Invoice between two dates for a customer type
  176. local m, LMARG
  177.  
  178.  
  179. LMARG := iif( PDEST()  = "S", "", space(5 ))
  180. do QBPUTH with 1, LMARG + REPHD1 
  181. do QBPUTH with 3, LMARG + REPHD3 
  182. m := LMARG + "Invoice  Owner Name" + space( 15 ) + ;
  183. "Vehicle    Date in  Date out" 
  184. do QBPUTH with 5, m 
  185. do QBPUTH with 6, " " 
  186. do while REPMORE( STARTD, FINISHD )
  187.     // 99999   XXXXXXXXXXXXXXXXXXXXXXXX X999XXXX  99/99/99  99/99/99
  188.     if REPGROUP( CGROUP )
  189.         m := LMARG + " " 
  190.         m := m + str( INVOICE->INVNO, 5 ) + "   " + INVOICE->OWNNAME + " " 
  191.         m := m + INVOICE->REGNO + "  " + dtoc( INVOICE->DATEIN ) + "  " 
  192.         m := m + dtoc( INVOICE->DATEOUT )
  193.         do QBPUTL with 1, m 
  194.     endif 
  195.     skip 
  196. enddo 
  197.  
  198. do QBPRCTL with [R:Finished  "Invoice List"] 
  199.  
  200. return 
  201.  
  202. //**********************************************************************
  203.  
  204. procedure REPREV( CGROUP, STARTD, FINISHD ) // Amended by SUMMER93
  205. // Calls: QBPUTH REPMORE REPGROUP INVFILL INVTOTAL QBPUTL QBPRCTL 
  206. // Called By: REPMAIN 
  207. //       Revenue for Customer group between two dates
  208. local TL, TP, TS, TV, to, TI, TT, m, LMARG
  209.  
  210. TL := TP := TS := TV := to := TI := TT := 0 
  211.  
  212.  
  213. LMARG := iif( PDEST()  = "S", "", space(5 ))
  214. do QBPUTH with 1, LMARG + REPHD1 
  215. do QBPUTH with 3, LMARG + REPHD3 
  216. if PDEST()  = "S" 
  217.     SWIDTH := 6 
  218.     BWIDTH := 8 
  219.     m := ;
  220.     "Invoice  Date     Labour     Total Special   V A T   Contributions     Total" 
  221. else 
  222.     SWIDTH := BWIDTH := 10 
  223.     m := LMARG + ;
  224.     "Invoice    D a t e s       Labour     Total   Special     V A T      Contributions      Total" 
  225. endif 
  226. do QBPUTH with 5, m 
  227. if PDEST()  = "S" 
  228.     m := "Number   Out      Charge     Parts Mater'l           Owner  Ins Co" 
  229. else 
  230.     m := LMARG + ;
  231.     "Number    In       Out     Charge     Parts   Mater'l               Owner    Ins Co" 
  232. endif 
  233. do QBPUTH with 6, m 
  234. do QBPUTH with 7, " " 
  235. //    99999 99/99/99 99/99/99 999999.99 999999.99 999999.99 999999.99 999999.99 999999.99 999999.99
  236. do while REPMORE( STARTD, FINISHD )
  237.     if REPGROUP( CGROUP )
  238.         INVFILL( .f. )
  239.         do INVTOTAL with .f. 
  240.         m := LMARG + str( MINVNO() , 5 ) + iif( PDEST()  = "S", "", " " + dtoc;
  241.         (MDATEIN() )) + " " + dtoc( MDATEOUT() )
  242.         m := m + str( MLABOURT() , 10, 2 ) + str( MINSPART()  + MOWNPART() , ;
  243.         10, 2 )
  244.         m := m + str( MINSSPEC()  + MOWNSPEC() , BWIDTH, 2 ) + str( IVATAMT() ;
  245.          + OVATAMT() , BWIDTH, 2 )
  246.         m := m + str( MOWNDUE() , BWIDTH, 2 ) + str( MINSDUE() , BWIDTH, 2 );
  247.          + str( MINVTOTAL() , 10, 2 )
  248.         TL := TL + MLABOURT() 
  249.         TP := TP + MINSPART()  + MOWNPART() 
  250.         TS := TS + MINSSPEC()  + MOWNSPEC() 
  251.         TV := TV + IVATAMT()  + OVATAMT() 
  252.         to  = to + MOWNDUE() 
  253.         TI := TI + MINSDUE() 
  254.         TT := TT + MINVTOTAL() 
  255.         do QBPUTL with 1, m 
  256.     endif 
  257.     skip 
  258. enddo 
  259.  
  260. m := LMARG + space( iif(PDEST()  = "S", 8, 17 )) + "Totals" + str( TL, 10, 2 );
  261.  + str( TP, 10, 2 ) + str( TS, BWIDTH, 2 ) + str( TV, BWIDTH, 2 )
  262. m := m + str( to, BWIDTH, 2 ) + str( TI, BWIDTH, 2 ) + str( TT, 10, 2 )
  263. do QBPUTL with 2, m 
  264.  
  265. do QBPRCTL with [R:Finished  "Revenue Report"] 
  266.  
  267. return 
  268.  
  269. //**********************************************************************
  270.  
  271. procedure REPWIP( CGROUP, STARTD, FINISHD ) // Amended by SUMMER93
  272. // Calls: QBPUTH REPGROUP INVFILL INVTOTAL QBPUTL QBPRCTL 
  273. // Called By: REPMAIN 
  274. //       Work in Progress report
  275. local TL, TP, TS, TV, to, TI, TT, m, LMARG
  276. //       Revenue for Customer group between two dates
  277.  
  278. TL := TP := TS := TV := to := TI := TT := 0 
  279.  
  280. LMARG := iif( PDEST()  = "S", "", space(5 ))
  281.  
  282. do QBPUTH with 1, LMARG + REPHD1 
  283. do QBPUTH with 3, LMARG + REPHD3 
  284. m := LMARG + ;
  285. "Invoice    D a t e s       Labour     Total   Special    V A T      Contributions     Total" 
  286. do QBPUTH with 5, m 
  287. m := LMARG + ;
  288. "Number    In       Out     Charge     Parts   Mater'l               Owner    Ins Co" 
  289. do QBPUTH with 6, m 
  290. do QBPUTH with 7, " " 
  291. //    99999 99/99/99 99/99/99 9999.99 9999.99 9999.99 9999.99 9999.99 9999.99 9999.99
  292.  
  293. do while !eof( )
  294.     if FIELD->INVNO <> 0 .and. FIELD->DATEINV  = ctod( "" ).and. REPGROUP( ;
  295.         CGROUP )
  296.         INVFILL( .f. )
  297.         do INVTOTAL with .f. 
  298.         m := LMARG + str( MINVNO() , 5 ) + " " + dtoc( MDATEIN() ) + " " + ;
  299.         dtoc( MDATEOUT() )
  300.         m := m + str( MLABOURT() , BWIDTH, 2 ) + str( MINSPART()  + ;
  301.         MOWNPART() , BWIDTH, 2 )
  302.         m := m + str( MINSSPEC()  + MOWNSPEC() , SWIDTH, 2 ) + str( IVATAMT() ;
  303.          + OVATAMT() , BWIDTH, 2 )
  304.         m := m + str( MOWNDUE() , SWIDTH, 2 ) + str( MINSDUE() , BWIDTH, 2 );
  305.          + str( MINVTOTAL() , BWIDTH, 2 )
  306.         TL := TL + MLABOURT() 
  307.         TP := TP + MINSPART()  + MOWNPART() 
  308.         TS := TS + MINSSPEC()  + MOWNSPEC() 
  309.         TV := TV + IVATAMT()  + OVATAMT() 
  310.         to  = to + MOWNDUE() 
  311.         TI := TI + MINSDUE() 
  312.         TT := TT + MINVTOTAL() 
  313.         do QBPUTL with 1, m 
  314.     endif 
  315.     skip 
  316. enddo 
  317.  
  318. m := LMARG + space( 17 ) + "Totals" + str( TL, BWIDTH, 2 ) + str( TP, BWIDTH, ;
  319. 2 ) + str( TS, SWIDTH, 2 ) + str( TV, BWIDTH, 2 )
  320. m := m + str( to, SWIDTH, 2 ) + str( TI, BWIDTH, 2 ) + str( TT, BWIDTH, 2 )
  321. do QBPUTL with 2, m 
  322.  
  323. do QBPRCTL with [R:Finished  "Current Work"] 
  324.  
  325. return 
  326.  
  327. // End of file
  328.